home *** CD-ROM | disk | FTP | other *** search
/ PC Answers 1995 May / PC Answers CD-ROM 7 (Future Publishing) (May 1995).iso / vbits / code / cert / trk3_eg / error / fil_open / saveas.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1993-04-06  |  4.6 KB  |  155 lines
  1. VERSION 2.00
  2. Begin Form frmSaveAs 
  3.    Caption         =   "File Save - Enter a file name"
  4.    ClientHeight    =   3600
  5.    ClientLeft      =   3195
  6.    ClientTop       =   2565
  7.    ClientWidth     =   5025
  8.    Height          =   4005
  9.    Icon            =   SAVEAS.FRX:0000
  10.    Left            =   3135
  11.    LinkMode        =   1  'Source
  12.    LinkTopic       =   "Form1"
  13.    ScaleHeight     =   3600
  14.    ScaleWidth      =   5025
  15.    Top             =   2220
  16.    Width           =   5145
  17.    Begin DirListBox Dir1 
  18.       Height          =   1845
  19.       Left            =   105
  20.       TabIndex        =   2
  21.       Top             =   1620
  22.       Width           =   3240
  23.    End
  24.    Begin DriveListBox Drive1 
  25.       Height          =   1530
  26.       Left            =   105
  27.       TabIndex        =   1
  28.       Top             =   1200
  29.       Width           =   3255
  30.    End
  31.    Begin CommandButton cmdCancel 
  32.       Cancel          =   -1  'True
  33.       Caption         =   "&Cancel"
  34.       Height          =   495
  35.       Left            =   3585
  36.       TabIndex        =   4
  37.       Top             =   750
  38.       Width           =   1215
  39.    End
  40.    Begin TextBox txtFileName 
  41.       Height          =   345
  42.       Left            =   105
  43.       MaxLength       =   8
  44.       TabIndex        =   0
  45.       Top             =   390
  46.       Width           =   1485
  47.    End
  48.    Begin CommandButton cmdOK 
  49.       Caption         =   "&OK"
  50.       Default         =   -1  'True
  51.       Enabled         =   0   'False
  52.       Height          =   495
  53.       Left            =   3570
  54.       TabIndex        =   3
  55.       Top             =   105
  56.       Width           =   1215
  57.    End
  58.    Begin Label lblPath 
  59.       Caption         =   "*.txt"
  60.       Height          =   320
  61.       Left            =   105
  62.       TabIndex        =   5
  63.       Top             =   840
  64.       Width           =   3240
  65.    End
  66.    Begin Label lblFileName 
  67.       Caption         =   "File Name:"
  68.       Height          =   300
  69.       Left            =   105
  70.       TabIndex        =   6
  71.       Top             =   100
  72.       Width           =   1785
  73.    End
  74. Option Explicit
  75. Sub cmdCancel_Click ()
  76.     'User wants to cancel
  77.     'Make fname = blank
  78.     fname = ""
  79.     'Unload the SAVEAS.FRM
  80.     Unload frmSaveAs
  81. End Sub
  82. Sub cmdOK_Click ()
  83.     'Handle bad filename situations
  84.     If InStr(txtFileName.Text, "\") <> 0 Or InStr(txtFileName.Text, ":") <> 0 Then
  85.         MsgBox "Enter filename only.  Use the file controls provided to select the proper drive and directory.", OK + WARNINGQUERY + FIRSTBUTTON, "Invalid Filename"
  86.     Else
  87.         'Build correct path and filename for fname
  88.         fname = Dir1.Path
  89.         If Right$(fname, 1) <> "\" Then fname = fname + "\"
  90.         fname = fname + txtFileName.Text
  91.         'Append a .txt extension
  92.         If Right$(fname, 4) <> "." Then fname = fname + ".txt"
  93.         
  94.         'Unload the SAVEAS.FRM
  95.         Unload frmSaveAs
  96.     End If
  97. End Sub
  98. Sub Dir1_Change ()
  99.     'Update the machine's current directory
  100.     ChDir (Dir1.Path)
  101.     'Update the label caption
  102.     lblPath.Caption = Dir1.Path
  103. End Sub
  104. Sub Drive1_Change ()
  105.     Dim rc As Integer
  106.     'Set the drive error trap
  107.     On Error GoTo SaveDriveError
  108.     'Update the directory list
  109.     Dir1.Path = Drive1.Drive
  110.     'Unset the drive error trap
  111.     On Error GoTo 0
  112.     Exit Sub
  113. SaveDriveError:
  114.     'Debug logic
  115.     MsgBox "The error is: " + Str$(Err) + " " + Error$
  116.     'Determine the File Error
  117.     Select Case Err
  118.         Case 68 'Device Unavailable
  119.             rc = MsgBox(" Drive Not Ready   ", ABORTRETRYIGNORE + WARNINGMESSAGE, "DRIVE ERROR")
  120.         Case Else ' Any other error
  121.             rc = MsgBox("Some other error " + Str$(Err) + " " + Error$, OK, "Unknown Error")
  122.     End Select
  123.               
  124.     'Process which key user pressed
  125.     Select Case rc
  126.         Case KEYRETRY
  127.             'Try again
  128.             Resume
  129.         Case KEYIGNORE
  130.             'Ignore, go on to next line
  131.             'Note that the drive has not really changed
  132.             Resume Next
  133.         Case KEYABORT
  134.             'Return to previous drive setting & Resume
  135.             Drive1.Drive = Left$(Dir1.Path, 2)
  136.             Resume
  137.         Case Else
  138.             'Unexpected key value
  139.             MsgBox "Unexpected results, key = " + Str$(rc), CRITICAL, "KEYERROR"
  140.             'End the Application
  141.             End
  142.     End Select
  143. End Sub
  144. Sub Form_Load ()
  145.     Dir1_Change
  146. End Sub
  147. Sub txtFileName_Change ()
  148.     'Decide whether to enable the OK button
  149.     If txtFileName.Text <> "" Then
  150.         cmdOK.Enabled = True
  151.     Else
  152.         cmdOK.Enabled = False
  153.     End If
  154. End Sub
  155.